home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fritz: All Fritz
/
All Fritz.zip
/
All Fritz
/
FILES
/
PROGMISC
/
FORTRAN1.LZH
/
DASCII.FOR
< prev
next >
Wrap
Text File
|
1988-02-08
|
3KB
|
123 lines
SUBROUTINE DASCII ( STRING )
C*
C* *******************************
C* *******************************
C* ** **
C* ** DASCII **
C* ** **
C* *******************************
C* *******************************
C*
C* SUBPROGRAM :
C* DEASCII
C*
C* AUTHOR :
C* ART RAGOSTA
C* MS 207-5
C* AMES RESEARCH CENTER
C* MOFFETT FIELD, CALIF 94035
C* (415) 694-5578
C*
C* PURPOSE :
C* REPLACE ALL NON-PRINTABLE CHARACTERS WITH A TEXT STRING
C* DENOTING THE CHARACTER. FOR THE CHARACTERS FROM ASCII 0 TO
C* ASCII 31 AND ASCII 127, THE STRING IS THE THREE CHARACETER
C* MNEMONIC IN BRACKETS (EG, <ESC>). FOR THE CHARACTERS FROM
C* ASCII 128 TO ASCII 255, THE STRING IS A THREE DIGIT NUMBER
C* IN BRACKETS (EG, <164>).
C*
C* INPUT ARGUMENTS :
C* STRING - A CHARACTER STRING TO BE DE-ASCIIFIED.
C*
C* OUTPUT ARGUMENTS :
C* STRING - THE DE-ASCIIFIED STRING (IN PLACE).
C*
C* INTERNAL WORK AREAS :
C* NONE
C*
C* COMMON BLOCKS :
C* NONE
C*
C* FILE REFERENCES :
C* NONE
C*
C* DATA BASE ACCESS :
C* NONE
C*
C* SUBPROGRAM REFERENCES :
C* NONE
C*
C* ERROR PROCESSING :
C* NONE
C*
C* TRANSPORTABILITY LIMITATIONS :
C* NONE
C*
C* ASSUMPTIONS AND RESTRICTIONS :
C* NONE
C*
C* LANGUAGE AND COMPILER :
C* ANSI FORTRAN 77
C*
C* VERSION AND DATE :
C* VERSION I.0 30-JAN-85
C*
C* CHANGE HISTORY :
C* 30-JAN-85 INITIAL VERSION
C*
C***********************************************************************
C*
CHARACTER *255 WORK
CHARACTER *(*) STRING
CHARACTER *3 TABLE(0:32), THREE
DATA TABLE /'NUL', 'SOH', 'STX', 'ETX', 'EOT', 'ENQ',
$ 'ACK', 'BEL', ' BS', ' HT', ' LF', ' VT', ' FF',
$ ' CR', ' SO', ' SI', 'DLE', 'DC1', 'DC2', 'DC3',
$ 'DC4', 'NAK', 'SYN', 'ETB', 'CAN', ' EM', 'SUB',
$ 'ESC', ' FS', ' GS', ' RS', ' US', 'DEL' /
C
L = LEN ( STRING )
IF ( L .GT. 255 ) L = 255
IW = 0
WORK = ' '
DO 100 I = 1, L
C
C --- TEST FOR PRINTABILITY
C
IF ((STRING(I:I) .LT. ' ') .OR. (STRING(I:I) .GT. '~')) THEN
IC = ICHAR ( STRING(I:I) )
IW = IW + 1
IF ( IW .GT. L ) GO TO 1000
WORK(IW:IW) = '<'
IW = IW + 1
IF ( IW+3 .GT. L ) GO TO 1000
C
C ------ SEE IF THERE IS AN ASCII MNEMONIC
C
IF ( IC .LE. 31 ) THEN
THREE = TABLE(IC)
ELSE IF ( IC .EQ. 127 ) THEN
THREE = TABLE(32)
ELSE
C
C ------ NO MNEMONIC, USE THREE DIGIT NUMBER
C
WRITE(THREE,900)IC
ENDIF
WORK(IW:IW+2) = THREE
IW = IW + 3
WORK(IW:IW) = '>'
ELSE
IW = IW + 1
IF (IW .GT. L) GO TO 1000
WORK(IW:IW) = STRING(I:I)
ENDIF
100 CONTINUE
1000 STRING = WORK
RETURN
900 FORMAT(I3)
END
C
C---END DASCII
C